{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Graphic;

interface

uses Classes, Types, AHMTypes, Colour, GDIPOBJ, GDIPAPI;

const
  THUMBNAIL_SIZE_THRESHOLD = 200;

type
  TAHMDBLockMode = (lmRead, lmWrite);

  TAHMBytePointer = ^Byte;

  TAHMBitmapData = record
    Width: Integer;
    Height: Integer;
    RowDelta: Integer;
    BytesPerPixel: Integer;
    PixelData: Pointer;
    LockMode: TAHMDBLockMode;
  end;

  TAHMGraphic = class(TPersistent)
  private
    FImage: TGPBitmap;
    FSprite: TObject; // TAHMDXSprite: avoids circular reference
    FWidth: Single;
    FHeight: Single;
    FFormat: TAHMTextureFormat;
    FImageWidth: Integer;
    FImageHeight: Integer;
    FAspect: Boolean;
    FFilename: WideString;
    FDodgyFile: WideString;
    FLocked: Boolean;
    FLockData: TBitmapData;
    FLoaded: Boolean;
  protected
    procedure SetWidth(Width: Single);
    procedure SetHeight(Height: Single);
    function GetImageRect: TAHMRectF;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property ImageWidth: Integer read FImageWidth;
    property ImageHeight: Integer read FImageHeight;
    property Width: Single read FWidth write SetWidth;
    property Height: Single read FHeight write SetHeight;
    property ImageRect: TAHMRectF read GetImageRect;
    property PreserveAspect: Boolean read FAspect write FAspect;
    property Filename: WideString read FFilename write FFilename;
    property Loaded: Boolean read FLoaded;
    procedure Invalidate;
    procedure ResizeImage(Width, Height: Integer);
    function LoadFromFile(const Filename: WideString): Boolean;
    procedure DrawGraphic(SrcRect, DestRect: TAHMRectF; Shade: TAHMCanvasShade; Gamma: TAHMCanvasColour;
                          XScale, YScale: Single; XFlip, YFlip: Boolean); overload;
    procedure DrawGraphic(SrcRect, DestRect, ClipRect: TAHMRectF; Shade: TAHMCanvasShade; Gamma: TAHMCanvasColour;
                          XScale, YScale: Single; XFlip, YFlip: Boolean); overload;
    function PopulateSprite: Boolean;
    function LockGraphic(var Lock: TAHMBitmapData): Boolean;
    procedure UnlockGraphic;
  published
  end;

implementation

uses SysUtils, Math, DirectXHelper, DirectXSprite, Canvas, Logging, Screen;

constructor TAHMGraphic.Create;
begin
  inherited Create;

  // Store appropriate image pixel format to use (16/32 bit)
  FFormat := ScreenInstance.TextureFormat;
end;

destructor TAHMGraphic.Destroy;
begin
  // Ensure we free our cached DX objects and image
  FSprite.Free;
  FImage.Free;

  inherited Destroy;
end;

procedure TAHMGraphic.SetWidth(Width: Single);
begin
  // If width changes then we need to reload image
  if Width <> FWidth then
  begin
    FWidth := Width;
    Invalidate;
  end;
end;

procedure TAHMGraphic.SetHeight(Height: Single);
begin
  // If height changes then we need to reload image
  if Height <> FHeight then
  begin
    FHeight := Height;
    Invalidate;
  end;
end;

function TAHMGraphic.GetImageRect: TAHMRectF;
begin
  // Return full image dimensions - could specify cropping here if required
  Result := MakeRectF(0, 0, 1, 1);
end;

procedure TAHMGraphic.Assign(Source: TPersistent);
begin
  // Copy image properties from passed source graphic.
  if Source is TAHMGraphic then
  begin
    FWidth := TAHMGraphic(Source).Width;
    FHeight := TAHMGraphic(Source).Height;
    FAspect := TAHMGraphic(Source).PreserveAspect;

    // Load our own image instance from passed filename
    FFilename := ''; // Clear so we force file to be loaded
    LoadFromFile(TAHMGraphic(Source).Filename);
  end;
end;

procedure TAHMGraphic.Invalidate;
begin
  // Clear loaded flag and release DirectX surfaces
  FLoaded := False;
  FreeAndNil(FSprite);
end;

procedure TAHMGraphic.ResizeImage(Width, Height: Integer);
var
  NewImage: TGPBitmap;
  ImgAspect: Single;
  ThumbSize: Integer;
  Renderer: TGPGraphics;
begin
  // Check this isn't a pointless exercise
  if Assigned(FImage) and ((FImageWidth <> Width) or (FImageHeight <> Height)) then
  begin
    // Tweak output image size to match the original image aspect ratio if req'd
    if FAspect and (FImageWidth > 0) and (FImageHeight > 0) then
    begin
      // Calculate image aspect ratio
      ImgAspect := FImageWidth / FImageHeight;

      // Scale image whilst preserving aspect ratio
      if (Width / ImgAspect) < Height then
        Height := Round(Width / ImgAspect)
      else
        Width := Round(Height * ImgAspect);
    end;

    // Method for sizing depends on the image size. For small images it's
    // faster to return the embedded image thumbnail, but for larger images
    // we need to explicitly resize the image as thumbs look poor when enlarged
    ThumbSize := Round(ScreenInstance.ScaleVirtualValue(THUMBNAIL_SIZE_THRESHOLD));
    if (Width > ThumbSize) or (Height > ThumbSize) then
    begin
      NewImage := TGPBitmap.Create(Width, Height, FImage.GetPixelFormat);
      Renderer := TGPGraphics.Create(NewImage);
      Renderer.DrawImage(FImage, 0, 0, Width, Height);
      Renderer.Free;
    end
    else
      NewImage := TGPBitmap(FImage.GetThumbnailImage(Width, Height, nil, nil));

    // Store new dimensions and image instance
    FImageWidth := Width;
    FImageHeight := Height;
    FImage.Free;
    FImage := NewImage;

    // Ensure we release any cached DirectX textures
    FreeAndNil(FSprite);
  end;
end;

function TAHMGraphic.LoadFromFile(const Filename: WideString): Boolean;
var
  ScaledWidth, ScaledHeight: Integer;
begin
  Result := False;

  // Validate passed filename (unless we already have filename stored)
  if (Filename = '') and (FFilename = '') then Exit;
  if ((Filename = FDodgyFile) or (Filename = '')) and (FDodgyFile <> '') then Exit;

  // Is this a new image ?
  if (not FLoaded) or (Filename <> FFilename) then
  try
    // Invalidate current image and DirectX cached surfaces
    Invalidate;

    // Free any previous image instance so we can pass filename to constructor
    FreeAndNil(FImage);

    // Load image and store size properties
    if Filename <> '' then FFilename := Filename;
    FImage := TGPBitmap.Create(FFilename);
    FImageWidth := FImage.GetWidth;
    FImageHeight := FImage.GetHeight;
    if (FImageWidth = 0) or (FImageHeight = 0) then Abort;

    // Do we want image to be resized explicitly?
    if (FWidth > 0) or (FHeight > 0) then
    begin
      // We need to stretch our virtual size image to match screen size
      ScaledWidth := Round(FWidth * ScreenInstance.PhysicalWidth);
      ScaledHeight := Round(FHeight * ScreenInstance.PhysicalHeight);
      ResizeImage(ScaledWidth, ScaledHeight);
    end
    else
    begin
      // No explict size, so derive image scale from screen dimensions
      FWidth := FImageWidth / ScreenInstance.PhysicalWidth;
      FHeight := FImageHeight / ScreenInstance.PhysicalHeight;
    end;

    FLoaded := True;
    Result := True;
  except
    // Problem loading image - bail out
    LogWarn('Failed to load image: ' + FFilename);
    FreeAndNil(FImage);

    // Don't try to load this image again
    FDodgyFile := FFilename;
  end;
end;

procedure TAHMGraphic.DrawGraphic(SrcRect, DestRect: TAHMRectF; Shade: TAHMCanvasShade;
                                  Gamma: TAHMCanvasColour; XScale, YScale: Single; XFlip, YFlip: Boolean);
begin
  // Ask DirectX to render our sprite for us
  if PopulateSprite then
    DirectXInstance.DrawSprite(TAHMDXSprite(FSprite), SrcRect, DestRect, Shade,
                               Gamma, XScale, YScale, XFlip, YFlip);
end;

procedure TAHMGraphic.DrawGraphic(SrcRect, DestRect, ClipRect: TAHMRectF; Shade: TAHMCanvasShade;
                                  Gamma: TAHMCanvasColour; XScale, YScale: Single; XFlip, YFlip: Boolean);
begin
  // And now, ask DirectX to render our sprite for us
  if PopulateSprite then
    DirectXInstance.DrawSprite(TAHMDXSprite(FSprite), SrcRect, DestRect, ClipRect, Shade,
                               Gamma, XScale, YScale, XFlip, YFlip);
end;

function TAHMGraphic.PopulateSprite: Boolean;
var
  LockData: TAHMBitmapData;
begin
  // Set default result - failed to populate sprite texture with graphic
  Result := False;

  // First ensure that we have validated the image
  if not Assigned(FImage) then Exit;

  // Allocate a directX sprite object to render our image
  if not Assigned(FSprite) then
    FSprite := DirectXInstance.SpriteManager.CreateSpriteFromGraphic(Self);

  // If sprite not yet available (i.e. no image loaded then copy image to sprite)
  if not TAHMDXSprite(FSprite).Available then
  begin
    // Lock graphic so we can copy it to our texture surface
    LockData.LockMode := lmRead;
    if LockGraphic(LockData) then
    begin
      DirectXInstance.SpriteManager.UpdateSprite(TAHMDXSprite(FSprite), LockData);
      UnlockGraphic;
    end;
  end;

  // Success
  Result := True;
end;

function TAHMGraphic.LockGraphic(var Lock: TAHMBitmapData): Boolean;
var
  Status: TStatus;
  LockFormat: TPixelFormat;
  LockMode: TAHMDBLockMode;
  LockFlags: Integer;
  Rect: TAHMRect;
begin
  Result := False;

  // First ensure that we have validated the image
  if not Assigned(FImage) then Exit;

  if FLocked then
  begin
    LogError('Attempted to relock previously locked GDI graphic for direct access');
    Exit;
  end;

  // Determine locking requirements and clear lock record
  LockMode := Lock.LockMode;
  FillChar(Lock, SizeOf(TAHMBitmapData), 0);
  Lock.LockMode := LockMode;
  if LockMode = lmRead then LockFlags := ImageLockModeRead
                       else LockFlags := ImageLockModeWrite;
  if FFormat = tf32Bit then LockFormat := PixelFormat32bppARGB
                       else LockFormat := PixelFormat16bppARGB1555;
  Rect := MakeRect(0, 0, FImageWidth, FImageHeight);

  // Attempt to aquire the lock
  Status := FImage.LockBits(TGPRect(Rect), LockFlags, LockFormat, FLockData);
  if Status <> Ok then
    LogWarn('Failed to lock GDI graphic for direct access: ' + IntToStr(Ord(Status)))
  else
  begin
    // Successfully aquired lock, pass details back to caller
    Result := True;
    FLocked := True;
    Lock.Width := FLockData.Width;
    Lock.Height := FLockData.Height;
    Lock.RowDelta := FLockData.Stride;
    Lock.PixelData := FLockData.Scan0;
    if FFormat = tf32Bit then Lock.BytesPerPixel := 4
                         else Lock.BytesPerPixel := 2;
  end;
end;

procedure TAHMGraphic.UnlockGraphic;
begin
  // Release previous lock on bitmap data
  if FLocked and Assigned(FImage) then
    FImage.UnlockBits(FLockData);
  FLocked := False;
end;


end.
